home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Libraries / SAT 2.4.0 / SAT / Add-ons / Graphic effects / SATSetDepth.p < prev   
Encoding:
Text File  |  1997-01-12  |  3.5 KB  |  124 lines  |  [TEXT/PJMM]
  1. {A unit for setting the screen depth.}
  2. {It follows the usual SAT standard for backwards compatibility - i.e. does NOT}
  3. {require Color QD!}
  4. {If you want to check/set for the main device, pass nil for the device. That way}
  5. {you can avoid all CQD-dependent calls in your own code.}
  6.  
  7. {Note! This unit is independent of SAT. Thus, it can NOT inform SAT of the depth switch, but}
  8. {you have to do that yourself! Call SATDepthChangeTest to let SAT redraw all faces}
  9. {it can. Faces created with GetFaceFromPICT and other advanced ways are your responsability}
  10. {to update.}
  11.  
  12. {Written in Juni-96, based on DepthSet. Tested och debugged september -96.}
  13.  
  14. unit SATSetDepth;
  15.  
  16. interface
  17.     uses
  18. {$ifc undefined THINK_PASCAL}
  19.         Types, QuickDraw, Events, Windows, Dialogs, Fonts, DiskInit, TextEdit, Traps, {}
  20.         Memory, SegLoad, Scrap, ToolUtils, OSUtils, Menus, Resources, StandardFile,{}
  21.         GestaltEqu, Files, Errors, Devices, {}
  22. {$elsec}
  23.         InterfacesUI, 
  24. {$endc}
  25.         Palettes;
  26.  
  27.     function SATHasDepth (theDevice: GDHandle; desiredDepth: Integer): Boolean;
  28.     function SATGetDepth (theDevice: GDHandle): Integer;
  29.     function SATSetDepth (theDevice: GDHandle; desiredDepth: Integer): OSErr;
  30.     function SATGetMode (theDevice: GDHandle): Boolean;
  31.     function SATSetMode (theDevice: GDHandle; wantsColor: Boolean): OSErr;
  32.     procedure SATRestoreDepth;
  33.  
  34. implementation
  35.  
  36.     var
  37.         savedDepth: Integer; {Set by SATSetDepth, used by SATRestoreDepth.}
  38.  
  39.     function HasColorQD: Boolean;
  40.         var
  41.             theWorld: SysEnvRec;
  42.     begin
  43.         HasColorQD := false;
  44.         if SysEnvirons(1, theWorld) = noErr then
  45.             HasColorQD := theWorld.hasColorQD;
  46.     end; {HasColorQD}
  47.  
  48.     function SATHasDepth (theDevice: GDHandle; desiredDepth: Integer): Boolean;
  49.     begin
  50.         SATHasDepth := false;
  51.         if not HasColorQD then
  52.             SATHasDepth := desiredDepth = 1 {Unimplemented trap error}
  53.         else
  54.             begin
  55.                 if theDevice = nil then
  56.                     theDevice := GetMainDevice;
  57.                 SATHasDepth := 0 <> HasDepth(theDevice, desiredDepth, gdDevType, desiredDepth);
  58.             end;
  59.     end; {SATHasDepth}
  60.  
  61. {Get the depth of a screen. When SAT is initialized, use gSAT.initDepth instead!}
  62.     function SATGetDepth (theDevice: GDHandle): Integer;
  63.         var
  64.             err: OSErr;
  65.     begin
  66.         SATGetDepth := 1;
  67.         if HasColorQD then
  68.             begin
  69.                 if theDevice = nil then
  70.                     theDevice := GetMainDevice;
  71.                 SATGetDepth := theDevice^^.gdPMap^^.pixelSize;
  72.             end;
  73.     end; {SATGetDepth}
  74.  
  75. {If you change the depth after SAT has initialized, don't forget to call}
  76. {SATDepthChangeTest!}
  77.     function SATSetDepth (theDevice: GDHandle; desiredDepth: Integer): OSErr;
  78.         var
  79.             err: OSErr;
  80.     begin
  81.         if not HasColorQD then
  82.             err := dsCoreErr {Unimplemented trap error}
  83.         else
  84.             begin
  85.                 if theDevice = nil then
  86.                     theDevice := GetMainDevice;
  87.  
  88. { Remember old bit depth }
  89. {oldDepth := theDev^^.gdPMap^^.pixelSize;}
  90. { Change bit depth if available }
  91.                 if HasDepth(theDevice, desiredDepth, gdDevType, desiredDepth) <> 0 then
  92.                     begin
  93.                         savedDepth := theDevice^^.gdPMap^^.pixelSize;
  94.                         err := SetDepth(theDevice, desiredDepth, gdDevType, 1);
  95.                     end
  96.                 else
  97.                     ;
  98.             end;
  99.         SATSetDepth := err;
  100.     end; {SATSetDepth}
  101.  
  102.     function SATGetMode (theDevice: GDHandle): Boolean;
  103.     begin
  104.         if not HasColorQD then
  105.             SATGetMode := false
  106.         else
  107.             SATGetMode := TestDeviceAttribute(theDevice, gdDevType);
  108.     end; {SATGetMode}
  109.  
  110.     function SATSetMode (theDevice: GDHandle; wantsColor: Boolean): OSErr;
  111.         var
  112.             err: OSErr;
  113.     begin
  114.         err := SetDepth(theDevice, theDevice^^.gdPMap^^.pixelSize, BSL(1, gdDevType), Integer(wantsColor));
  115.     end; {SATSetMode}
  116.  
  117.     procedure SATRestoreDepth;
  118.     begin
  119.         if savedDepth <> 0 then
  120.             if noErr <> SATSetDepth(nil, savedDepth) then
  121.                 ;
  122.     end; {SATRestoreDepth}
  123.  
  124. end.